home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / NAVIGATE.PRG < prev    next >
Encoding:
Text File  |  1993-11-22  |  30.1 KB  |  773 lines
  1. *-----------------------------------------------------------------------
  2. *-- Program...: NAVIGATE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 09/01/1993
  5. *-- Notes.....: These are interesting functions designed to help out in 
  6. *--             navigation ... see the file: README.TXT for details on 
  7. *--             the use of this library file. 
  8. *--             NOTE -- a few functions have been added into this 
  9. *--             library that are duplicated elsewhere (other library 
  10. *--             files). This is due to a limitation with dBASE IV, 
  11. *--             1.5's handling of libraries.
  12. *--             These functions are (and are from):
  13. *--             STRIP2VAL()   from STRINGS.PRG
  14. *--             STRIPVAL()
  15. *--             STRPBRK()
  16. *--             HAV()         from TRIG.PRG
  17. *--             AHAV()
  18. *--             CSCH()
  19. *--             SINH()
  20. *-----------------------------------------------------------------------
  21.  
  22. FUNCTION Correct
  23. *-----------------------------------------------------------------------
  24. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  25. *-- Date........: 03/01/1992
  26. *-- Notes.......: Correction of direction - adjusts direction given, in 
  27. *--               degrees, by second number of degrees.  Use to convert 
  28. *--               a compass direction to magnetic using deviation as the
  29. *--               second argument, or magnetic to true using variation 
  30. *--               as the second argument. Returns a direction in 
  31. *--               degrees.
  32. *--
  33. *--               A westerly second argument may be given either as a 
  34. *--               negative number or as a character value containing 
  35. *--               "W".  If second argument is character-type but 
  36. *--               contains a negative value, effect of presence or 
  37. *--               absence of "W" is reversed.  That is, "-20 W" is 
  38. *--               treated like "20 E" or the number 20.
  39. *-- Written for.: dBASE IV, 1.1
  40. *-- Rev. History: 03/01/1992 -- Original Release
  41. *-- Calls.......: None
  42. *-- Called by...: Any
  43. *-- Usage.......: Correct(<nDirection>,<xCorrection>)
  44. *-- Example.....: ?Correct(50,"-10 E")
  45. *-- Returns.....: Numeric (direction in degrees)
  46. *-- Parameters..: nDirection  = Heading
  47. *--               xCorrection = amount to 'correct' by, may be numeric 
  48. *--                             or character, see above under 'Notes'.
  49. *-----------------------------------------------------------------------
  50.  
  51.    parameters nDirection, xCorrection
  52.    private nCval
  53.    if type( "xCorrection" ) = "C"
  54.       m->nCVal = val( m->xCorrection )
  55.       if "W" $ upper( m->xCorrection )
  56.          m->nCVal = - m->nCVal
  57.       endif
  58.    else
  59.       m->nCVal = m->xCorrection
  60.    endif
  61.    
  62. RETURN mod( 360 + m->nDirection + m->nCVal, 360 )
  63. *-- EoF: Correct()
  64.  
  65. FUNCTION UnCorrect
  66. *-----------------------------------------------------------------------
  67. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  68. *-- Date........: 03/01/1992
  69. *-- Notes.......: Uncorrection of direction - adjusts direction given, 
  70. *--               in degrees, by second number of degrees.  The inverse 
  71. *--               of correct(), see above. Use to convert a true 
  72. *--               direction to magnetic using variation as the second
  73. *--               argument, or magnetic to compass using deviation as
  74. *--               the second argument.
  75. *-- Written for.: dBASE IV, 1.1
  76. *-- Rev. History: 03/01/1992 -- Original Release
  77. *-- Calls.......: None
  78. *-- Called by...: Any
  79. *-- Usage.......: UnCorrect(<nDirection>,<xUnCorr>)
  80. *-- Example.....: ?UnCorrect(50,"-10 E")
  81. *-- Returns.....: Numeric (direction in degrees)
  82. *-- Parameters..: nDirection = Heading
  83. *--               xUnCorr    = amount to 'uncorrect' by, may be numeric 
  84. *--                            or character, see above under 'Notes'.
  85. *-----------------------------------------------------------------------
  86.  
  87.    parameters nDirection, xUncorr
  88.    private m->nCVal
  89.    if type( "xUncorr" ) = "C"
  90.       m->nCVal = val( m->xUncorr )
  91.       if "W" $ upper( m->xUncorr )
  92.          m->nCVal = - m->nCVal
  93.       endif
  94.    else
  95.       m->nCVal = m->xUncorr
  96.    endif
  97.    
  98. RETURN mod( 360 + m->nDirection - m->nCVal, 360 )
  99. *-- EoF: UnCorrect()
  100.  
  101. FUNCTION XAngle
  102. *-----------------------------------------------------------------------
  103. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  104. *-- Date........: 03/01/1992
  105. *-- Notes.......: Angle in degrees ( <= 90 ) at which two vectors in
  106. *--               degrees intersect.
  107. *-- Written for.: dBASE IV, 1.1
  108. *-- Rev. History: 03/01/1992 -- Original Release
  109. *-- Calls.......: None
  110. *-- Called by...: Any
  111. *-- Usage.......: XAngle(<nVector1>,<nVector2>)
  112. *-- Example.....: ?UnCorrect(20,240)
  113. *-- Returns.....: Numeric (direction in degrees)
  114. *-- Parameters..: nVector1 = First angle
  115. *--               nVector2 = Second angle
  116. *-----------------------------------------------------------------------
  117.  
  118.    parameters nVector1, nVector2
  119.    private nResult
  120.    m->nResult = abs( m->nVector1 - m->nVector2)
  121.    do case
  122.       case m->nResult > 270
  123.            m->nResult = 360 - m->nResult
  124.       case m->nResult > 180
  125.            m->nResult = m->nResult - 180
  126.       case m->nResult > 90
  127.            m->nResult = 180 - m->nResult
  128.    endcase
  129.    
  130. RETURN m->nResult
  131. *-- EoF: XAngle()
  132.  
  133. FUNCTION LeftWind
  134. *-----------------------------------------------------------------------
  135. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  136. *-- Date........: 03/01/1992
  137. *-- Notes.......: Whether effect of second vector on first is from the
  138. *--               left or the right.  Returns .T. if from the left, else
  139. *--               .F.  Expects vectors in degrees.
  140. *--
  141. *--               For convenience in aviation calculations, the second
  142. *--               argument is expected as the direction FROM which
  143. *--               the wind or current is coming, not the direction TO
  144. *--               which it is going.  If the contrary sense
  145. *--               is more convenient, change the "=" sign in the
  146. *--               function to "#".
  147. *-- Written for.: dBASE IV, 1.1
  148. *-- Rev. History: 03/01/1992 -- Original Release
  149. *-- Calls.......: None
  150. *-- Called by...: Any
  151. *-- Usage.......: LeftWind(<nCourse>,<nWindFrom>)
  152. *-- Example.....: ?LeftWind(20,240)
  153. *-- Returns.....: Numeric (direction in degrees)
  154. *-- Parameters..: nCourse   = Direction of heading ...
  155. *--               nWindFrom = Direction wind or current is coming from
  156. *-----------------------------------------------------------------------
  157.  
  158.    parameters nCourse, nWindfrom
  159.    
  160. RETURN ( m->nCourse > m->nWindfrom ) = ( abs( m->nCourse - ;
  161.                       m->nWindfrom ) < 180 )
  162. *-- EoF: LeftWind()
  163.  
  164. FUNCTION TailWind
  165. *-----------------------------------------------------------------------
  166. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  167. *-- Date........: 03/01/1992
  168. *-- Notes.......: Whether effect of second vector on first is additive
  169. *--               or subtractive ( from behind or from ahead ).
  170. *-- 
  171. *--               For convenience in aviation calculations, the second
  172. *--               argument is expected as the direction FROM which
  173. *--               the wind or current is coming, not the direction TO
  174. *--               which is going.  If the contrary sense
  175. *--               is more convenient, change the "<" sign in the
  176. *--               function to ">".
  177. *-- Written for.: dBASE IV, 1.1
  178. *-- Rev. History: 03/01/1992 -- Original Release
  179. *-- Calls.......: None
  180. *-- Called by...: Any
  181. *-- Usage.......: TailWind(<nCourse>,<nWindFrom>)
  182. *-- Example.....: ?TailWind(20,240)
  183. *-- Returns.....: Numeric (direction in degrees)
  184. *-- Parameters..: nCourse   = Direction of heading ...
  185. *--               nWindFrom = Direction wind or current is coming from
  186. *-----------------------------------------------------------------------
  187.  
  188.    parameters nCourse, nWindfrom
  189.    
  190. RETURN ( abs( abs( m->nCourse - m->nWindfrom ) - 180 ) < 90 )
  191. *-- EoF: TailWind()
  192.  
  193. FUNCTION Heading
  194. *-----------------------------------------------------------------------
  195. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  196. *-- Date........: 03/01/1992
  197. *-- Notes.......: Heading required to make good a course.
  198. *--               If using this for boating and the direction of set is
  199. *--               more convenient than the direction from which
  200. *--               it is coming, apply mod( 180 + direction, 360 )
  201. *--               to the fourth argument before calling.
  202. *-- Written for.: dBASE IV, 1.1
  203. *-- Rev. History: 03/01/1992 -- Original Release
  204. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  205. *--               LEFTWIND()           Function in NAVIGATE.PRG
  206. *-- Called by...: Any
  207. *-- Usage.......: Heading(<nCourse>,<nAirSpeed>,<nWindFrom>,<nForce>)
  208. *-- Example.....: ?Heading(20,5,240,2)
  209. *-- Returns.....: Numeric (direction in degrees)
  210. *-- Parameters..: nCourse   = Direction of heading ...
  211. *--               nAirSpeed = What it says
  212. *--               nWindFrom = Direction wind or current is coming from
  213. *--               nForce    = Windforce
  214. *-----------------------------------------------------------------------
  215.  
  216.    parameters nCourse, nAirspeed, nWindfrom, nForce
  217.    private nCrabAngle
  218.    m->nCrabAngle = rtod( asin( m->nForce * ;
  219.                    sin( dtor( xangle( m->nCourse, m->nWindFrom))) ;
  220.                    / m->nAirSpeed ) )
  221.    m->nCrabAngle = iif( leftwind( m->nCourse, m->nWindFrom ),;
  222.                         -m->nCrabAngle, m->nCrabAngle )
  223.    m->nCrabAngle = mod( 360 + m->nCourse + m->nCrabAngle, 360 )
  224.    
  225. RETURN iif( abs( m->nCrabAngle ) < 360, m->nCrabAngle, -1 )
  226. *-- EoF: Heading()
  227.  
  228. FUNCTION Course
  229. *-----------------------------------------------------------------------
  230. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  231. *-- Date........: 03/01/1992
  232. *-- Notes.......: Course made good given heading, speed and wind 
  233. *--               direction and force.
  234. *-- Written for.: dBASE IV, 1.1
  235. *-- Rev. History: 03/01/1992 -- Original Release
  236. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  237. *--               LEFTWIND()           Function in NAVIGATE.PRG
  238. *--               TAILWIND()           Function in NAVIGATE.PRG
  239. *-- Called by...: Any
  240. *-- Usage.......: Course(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  241. *-- Example.....: ?Course(20,5,240,2)
  242. *-- Returns.....: Numeric (direction in degrees)
  243. *-- Parameters..: nHeading  = Direction of heading ...
  244. *--               nAirSpeed = What it says
  245. *--               nWindFrom = Direction wind or current is coming from
  246. *--               nForce    = Windforce
  247. *-----------------------------------------------------------------------
  248.  
  249.    parameters nHeading, nAirspeed, nWindfrom, nForce
  250.    private nTemp, nCrabAngle
  251.    m->nTemp = dtor( xangle( m->nHeading, m->nWindFrom ) )
  252.    m->nCrabAngle = m->nAirSpeed - m->nForce * cos( m->nTemp ) ;
  253.                    * iif( tailwind( m->nHeading, m->nWindFrom ), -1, 1 )
  254.    if m->nCrabAngle < 0
  255.       m->nCrabAngle = 0
  256.    else
  257.       m->nCrabAngle = abs( rtod( atan( m->nForce * sin( m->nTemp );
  258.                       / m->nCrabAngle ) ) )
  259.       m->nCrabAngle = iif( leftwind( m->nHeading,m->nWindFrom ),;
  260.                       m->nCrabAngle, -m->nCrabAngle)
  261.    endif
  262.    
  263. RETURN mod( 360 + m->nHeading + m->nCrabAngle, 360 )
  264. *-- EoF: Course()
  265.  
  266. FUNCTION GndSpeed
  267. *-----------------------------------------------------------------------
  268. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  269. *-- Date........: 03/01/1992
  270. *-- Notes.......: Speed over the ground given heading, speed
  271. *--               and wind direction and force.
  272. *-- Written for.: dBASE IV, 1.1
  273. *-- Rev. History: 03/01/1992 -- Original Release
  274. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  275. *--               TAILWIND()           Function in NAVIGATE.PRG
  276. *-- Called by...: Any
  277. *-- Usage.......: GndSpeed(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  278. *-- Example.....: ?GndSpeed(20,5,240,2)
  279. *-- Returns.....: Numeric (direction in degrees)
  280. *-- Parameters..: nHeading  = Direction of heading ...
  281. *--               nAirSpeed = What it says
  282. *--               nWindFrom = Direction wind or current is coming from
  283. *--               nForce    = Windforce
  284. *-----------------------------------------------------------------------
  285.  
  286.    parameters nHeading, nAirspeed, nWindfrom, nForce
  287.    private nTemp
  288.    m->nTemp  = cos( dtor( xangle( m->nHeading, m->nWindFrom ) ) ) ;
  289.                * iif( tailwind( m->nHeading, m->nWindFrom ), -1, 1 )
  290.    m->nTemp = m->nAirSpeed * m->nAirSpeed + m->nForce * m->nForce ;
  291.               - 2 * m->nAirSpeed * m->nForce * m->nTemp
  292.  
  293. RETURN iif(m->nTemp<=0,m->nAirSpeed+m->nForce*iif(tailwind(m->nHeading,;
  294.            m->nWindFrom ),1,-1),sqrt(m->nTemp))
  295. *-- EoF: GndSpeed()
  296.  
  297. FUNCTION Deg2Num
  298. *-----------------------------------------------------------------------
  299. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  300. *-- Date........: 03/01/1992
  301. *-- Notes.......: Degrees to number: String in the form " 40d50'30.2 N" 
  302. *--               is converted to a number of degrees.  If followed by 
  303. *--               E or S, sign will be reversed.
  304. *--
  305. *--               It doesn't matter what characters are used to separate
  306. *--               the degrees, minutes and seconds, but any of the 
  307. *--               characters N, E, W and S or their lowercase 
  308. *--               equivalents following the last digit will be 
  309. *--               understood as specifying a compass direction.
  310. *-- 
  311. *--               If the degrees or minutes are 0, they must never-
  312. *--               theless be included in the argument.  Seconds may 
  313. *--               be omitted if 0, as may the minutes if 0 and seconds
  314. *--               are omitted.
  315. *-- Written for.: dBASE IV, 1.1
  316. *-- Rev. History: 03/01/1993 -- Original Release
  317. *-- Calls.......: STRIP2VAL()          Function in STRINGS.PRG
  318. *--               STRIPVAL()           Function in STRINGS.PRG
  319. *--               STRPBRK()            Function in STRINGS.PRG
  320. *-- Called by...: Any
  321. *-- Usage.......: Deg2Num(<cDms>)
  322. *-- Example.....: ?Deg2Num("40d50'30.2 N")
  323. *-- Returns.....: Numeric (degrees)
  324. *-- Parameters..: cDms = Degrees Minutes Seconds
  325. *-----------------------------------------------------------------------
  326.  
  327.    parameters cDms
  328.    private nResult, cStrleft
  329.    if type( "cDms" ) $ "NF"
  330.       RETURN m->cDms
  331.    endif
  332.    m->cStrLeft = strip2val( m->cDms )
  333.    m->nResult = val( m->cStrLeft )
  334.    if "" # strip2val( stripval( m->cStrLeft ) )
  335.       m->cStrLeft = strip2val( stripval( m->cStrLeft ) )
  336.       m->nResult = m->nResult + val( m->cStrLeft ) / 60
  337.       if "" # strip2val( stripval( m->cStrLeft ) )
  338.          m->cStrLeft = strip2val( stripval( m->cStrLeft ) )
  339.          m->nResult = m->nResult + val( m->cStrLeft ) / 3600
  340.       endif
  341.    endif
  342.    m->cStrLeft = upper( ltrim( stripval( m->cStrLeft ) ) )
  343.    if strpbrk("NW", m->cStrLeft ) > 0 .or. strpbrk( "ES",m->cStrLeft )=0
  344.       RETURN m->nResult
  345.    else
  346.      RETURN -m->nResult
  347.    endif
  348.  
  349. *-- EoF: Deg2Num()
  350.  
  351. FUNCTION BearsDist
  352. *-----------------------------------------------------------------------
  353. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  354. *-- Date........: 03/01/1992
  355. *-- Notes.......: Distance to an object at the time of the second
  356. *--               bearing, given two bearings and the distance run
  357. *--               between them.  Value returned will be in same
  358. *--               units as third argument; first two are in degrees.
  359. *--               Returns -1 if already past the object.
  360. *-- Written for.: dBASE IV, 1.1
  361. *-- Rev. History: 03/01/1992 -- Original Release
  362. *-- Calls.......: None
  363. *-- Called by...: Any
  364. *-- Usage.......: BearsDist(<nBear1>,<nBear2>,<nRun>)
  365. *-- Example.....: ?BearsDist(200,150,5)
  366. *-- Returns.....: Numeric (degrees)
  367. *-- Parameters..: nBear1 = Bearing of First object
  368. *--               nBear2 = Bearing of Second object
  369. *--               nRun   = Distance (or time) run between bearings
  370. *-----------------------------------------------------------------------
  371.  
  372.    parameters nBear1, nBear2, nRun
  373.    if m->nBear2 > 180
  374.      if m->nBear1 < m->nBear2 .or. m->nBear2 < 270
  375.        RETURN -1
  376.      else
  377.        m->nBear1 = 360 - m->nBear1
  378.        m->nBear2 = 360 - m->nBear2
  379.      endif
  380.    else
  381.      if m->nBear2 < m->nBear1 .or. m->nBear2 > 90
  382.        RETURN -1
  383.      endif
  384.    endif
  385.  
  386. RETURN sin( dtor( m->nBear1 ) ) * m->nRun / sin( dtor( m->nBear2 - ;
  387.        m->nBear1 ) )
  388. *-- EoF: BearsDist()
  389.  
  390. FUNCTION BearsPass
  391. *-----------------------------------------------------------------------
  392. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  393. *-- Date........: 03/01/1992
  394. *-- Notes.......: Distance at which the object will be passed abeam:
  395. *--                                  * <-- Object
  396. *--                            .    /|
  397. *--                      .         / |
  398. *--                1-->-->-->--2  >  3  >
  399. *--               Where 1 = Position at time first bearing to object is
  400. *--                         taken,
  401. *--                     2 = position at second bearing,
  402. *--                     3 = position at which the object will be abeam.
  403. *-- Written for.: dBASE IV, 1.1
  404. *-- Rev. History: 03/01/1992 -- Original Release
  405. *-- Calls.......: None
  406. *-- Called by...: Any
  407. *-- Usage.......: BearsPass(<nBear1>,<nBear2>,<nRun>)
  408. *-- Example.....: ?BearsPass(200,150,5)
  409. *-- Returns.....: Numeric (degrees)
  410. *-- Parameters..: nBear1 = Bearing of First object
  411. *--               nBear2 = Bearing of Second object
  412. *--               nRun   = Distance (or time) run between bearings
  413. *-----------------------------------------------------------------------
  414.  
  415.    parameters nBear1, nBear2, nRun
  416.    private nTemp
  417.    if m->nBear2 > 180
  418.      if m->nBear1 < m->nBear2 .or. m->nBear2 < 270
  419.        RETURN -1
  420.      else
  421.        m->nBear1 = 360 - m->nBear1
  422.        m->nBear2 = 360 - m->nBear2
  423.      endif
  424.    else
  425.      if m->nBear2 < m->nBear1 .or. m->nBear2 > 90
  426.        RETURN -1
  427.      endif
  428.    endif
  429.    m->nTemp = sin( dtor( m->nBear1 ) ) * ;
  430.               m->nRun / sin( dtor( m->nBear2 - m->nBear1 ) )
  431.    
  432. RETURN m->nTemp * sin( dtor( m->nBear2 ) )
  433. *-- EoF: BearsPass()
  434.  
  435. FUNCTION BearsRun
  436. *-----------------------------------------------------------------------
  437. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  438. *-- Date........: 03/01/1992
  439. *-- Notes.......: Distance to run until object will be abeam given two 
  440. *--               bearings. Same rules and restrictions as bearsdist().
  441. *-- Written for.: dBASE IV, 1.1
  442. *-- Rev. History: 03/01/1992 -- Original Release
  443. *-- Calls.......: None
  444. *-- Called by...: Any
  445. *-- Usage.......: BearsRun(<nBear1>,<nBear2>,<nRun>)
  446. *-- Example.....: ?BearsRun(200,150,5)
  447. *-- Returns.....: Numeric (degrees)
  448. *-- Parameters..: nBear1 = Bearing of First object
  449. *--               nBear2 = Bearing of Second object
  450. *--               nRun   = Distance (or time) run between bearings
  451. *-----------------------------------------------------------------------
  452.  
  453.    parameters nBear1, nBear2, nRun
  454.    private nTemp
  455.    if m->nBear2 > 180
  456.      if m->nBear1 < m->nBear2 .or. m->nBear2 < 270
  457.        RETURN -1
  458.      else
  459.        m->nBear1 = 360 - m->nBear1
  460.        m->nBear2 = 360 - m->nBear2
  461.      endif
  462.    else
  463.      if m->nBear2 < m->nBear1 .or. m->nBear2 > 90
  464.        RETURN -1
  465.      endif
  466.    endif
  467.    m->nTemp = sin( dtor( m->nBear1 ) ) * ;
  468.                m->nRun / sin( dtor( m->nBear2 - m->nBear1 ) )
  469.  
  470. RETURN m->nTemp * cos( dtor( m->nBear2 ) )
  471. *-- EoF: BearsRun()
  472.  
  473. FUNCTION GcDist
  474. *-----------------------------------------------------------------------
  475. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  476. *-- Date........: 03/01/1992
  477. *-- Notes.......: Great circle distance between two points given 
  478. *--               latitude and longitude of each.  This function obtains
  479. *--               the degrees of arc along the great circle and simply
  480. *--               multiplies by 60 to convert the degrees to nautical 
  481. *--               miles.  As this ignores the eccentricity of the earth,
  482. *--               the answer may be in error by approximately half of 
  483. *--               one percent.  In general, if the route lies close to
  484. *--               the equator the result of this function will be 
  485. *--               smaller than the actual number of nautical miles, but
  486. *--               if the route passes close to the poles the function 
  487. *--               result will be larger than the correct number.
  488. *-- Written for.: dBASE IV, 1.1
  489. *-- Rev. History: 03/01/1992 -- Original Release
  490. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  491. *--               HAV()                Function in TRIG.PRG
  492. *--               AHAV()               Function in TRIG.PRG
  493. *-- Called by...: Any
  494. *-- Usage.......: GCDist(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  495. *-- Example.....: ?GCDist(200,150,105,200)
  496. *-- Returns.....: Numeric (nautical miles)
  497. *-- Parameters..: cLat1 = Latitude 1
  498. *--               cLon1 = Longitude 1
  499. *--               cLat2 = Latitude 2
  500. *--               cLon2 = Longitude 2
  501. *-----------------------------------------------------------------------
  502.  
  503.    parameters cLat1, cLon1, cLat2, cLon2
  504.    private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp
  505.    m->nLa1 = dtor( deg2num( m->cLat1 ) )
  506.    m->nLo1 = dtor( deg2num( m->cLon1 ) )
  507.    m->nLa2 = dtor( deg2num( m->cLat2 ) )
  508.    m->nLo2 = dtor( deg2num( m->cLon2 ) )
  509.    m->nDla = abs( m->nLa1 - m->nLa2 )
  510.    m->nDlo = abs( m->nLo2 - m->nLo1 )
  511.    do case
  512.       case m->nDlo = 0 .or. m->nDla = pi()
  513.            RETURN 60 * rtod( m->nDla )
  514.       case m->nDlo = pi()
  515.            RETURN 60 * rtod( ( pi() - m->nDla ) )
  516.       case m->nDlo > pi()
  517.            m->nDlo = 2 * pi() - m->nDlo
  518.    endcase
  519.    m->nTemp = hav( m->nDla ) + hav( m->nDlo ) * cos( m->nLa1 ) *;
  520.               cos( m->nLa2 )
  521.  
  522. RETURN 60 * rtod( ahav( m->nTemp ) )
  523. *-- EoF: GcDist()
  524.  
  525. FUNCTION GcCourse
  526. *-----------------------------------------------------------------------
  527. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  528. *-- Date........: 03/01/1992
  529. *-- Notes.......: Initial great circle course between two points given 
  530. *--               latitude and longitude of each.  Returns -1 if the 
  531. *--               points are antipodes.
  532. *-- Written for.: dBASE IV, 1.1
  533. *-- Rev. History: 03/01/1992 -- Original Release
  534. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  535. *--               HAV()                Function in TRIG.PRG
  536. *--               AHAV()               Function in TRIG.PRG
  537. *--               CSCH()               Function in TRIG.PRG
  538. *-- Called by...: Any
  539. *-- Usage.......: GCCourse(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  540. *-- Example.....: ?GCCourse(200,150,105,200)
  541. *-- Returns.....: Numeric (degrees)
  542. *-- Parameters..: cLat1 = Latitude 1
  543. *--               cLon1 = Longitude 1
  544. *--               cLat2 = Latitude 2
  545. *--               cLon2 = Longitude 2
  546. *-----------------------------------------------------------------------
  547.  
  548.    parameters nLat1, nLon1, nLat2, nLon2
  549.    private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp, lRev
  550.    m->nLa1 = dtor( deg2num( m->nLat1 ) )
  551.    m->nLo1 = dtor( deg2num( m->nLon1 ) )
  552.    m->nLa2 = dtor( deg2num( m->nLat2 ) )
  553.    m->nLo2 = dtor( deg2num( m->nLon2 ) )
  554.    m->nDla = abs( m->nLa1 - m->nLa2 )
  555.    m->nDlo = abs( m->nLo2 - m->nLo1 )
  556.    m->lRev = .F.
  557.    do case
  558.       case m->nDla =pi() .or. m->nDlo = pi () .and. m->nLa1 + m->nLa2 =0
  559.            RETURN -1
  560.       case m->nDlo =0 .or. m->nDlo = pi() .or. abs( m->nLa1) =pi() .or.;
  561.            abs( m->nLa2 ) = pi()
  562.            RETURN iif( La1 > La2 , 180, 0 )
  563.       case m->nDlo > pi()
  564.            m->nDlo = 2 * pi() - m->nDlo
  565.            m->lRev = .T.
  566.    endcase
  567.    m->nTemp = hav( m->nDla ) + hav( m->nDlo ) * cos( m->nLa1 ) *;
  568.               cos( m->nLa2 )
  569.    m->nTemp = rtod( asin( sin( m->nDlo ) * cos( m->nLa2 ) *;
  570.               csch( ahav( m->nTemp ) ) ) )
  571.    m->nTemp = iif( m->nLa1 > m->nLa2, 180 - m->nTemp, m->nTemp )
  572.    
  573. RETURN iif( ( m->nLo2 > m->nLo1 ) = m->lRev, m->nTemp, 360 - m->nTemp )
  574. *-- EoF: GCCourse()
  575.  
  576. *-----------------------------------------------------------------------
  577. *-- For convenience the following routines were brought in from other 
  578. *-- library files.
  579. *-----------------------------------------------------------------------
  580.  
  581. FUNCTION Strip2Val
  582. *-----------------------------------------------------------------------
  583. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  584. *-- Date........: 03/01/1992
  585. *-- Notes.......: Strip characters from the left of a string until 
  586. *--               reaching one that might start a number.
  587. *-- Written for.: dBASE IV
  588. *-- Rev. History: 03/01/1992  -- Original Release
  589. *-- Calls.......: None
  590. *-- Called by...: Any
  591. *-- Usage.......: Strip2Val("<cStr>")
  592. *-- Example.....: ? Strip2Val("Test345")
  593. *-- Returns.....: character string
  594. *-- Parameters..: cStr = string to search
  595. *-----------------------------------------------------------------------
  596.  
  597.    parameters cStr
  598.    private cNew
  599.    m->cNew = m->cStr
  600.    do while "" # m->cNew
  601.       if left( m->cNew, 1 ) $ "-.0123456789"
  602.          exit
  603.       endif
  604.       m->cNew = substr( m->cNew, 2 )
  605.    enddo
  606.    
  607. RETURN m->cNew
  608. *-- EoF: Strip2Val()
  609.  
  610. FUNCTION StripVal
  611. *-----------------------------------------------------------------------
  612. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  613. *-- Date........: 03/01/1992
  614. *-- Notes.......: Strip characters from the left of the string until
  615. *--               reaching one that is not part of a number.  A hyphen
  616. *--               following numerics, or a second period,
  617. *--               is treated as not part of a number.
  618. *-- Written for.: dBASE IV
  619. *-- Rev. History: 03/01/1992 -- Original Release
  620. *-- Calls.......: None
  621. *-- Called by...: Any
  622. *-- Usage.......: StripVal("<cStr>")
  623. *-- Example.....: ? StripVal("123.2Test")
  624. *-- Returns.....: Character
  625. *-- Parameters..: cStr = string to test
  626. *-----------------------------------------------------------------------
  627.  
  628.    parameters cStr
  629.    private cNew, cChar, lGotminus, lGotdot
  630.    m->cNew = m->cStr
  631.    store .f. to m->lGotMinus, m->lGotDot
  632.    do while "" # m->cNew
  633.       m->cChar = left( m->cNew, 1 )
  634.       do case
  635.          case .not. m->cChar $ "-.0123456789"
  636.             exit
  637.          case m->cChar = "-"
  638.             if m->lGotMinus
  639.                exit
  640.             endif
  641.           case m->cChar = "."
  642.             if m->lGotDot
  643.                exit
  644.             else
  645.                m->lGotDot = .T.
  646.             endif
  647.       endcase
  648.       m->cNew = substr( m->cNew, 2 )
  649.       m->lGotMinus = .T.
  650.    enddo
  651.    
  652. RETURN m->cNew
  653. *-- EoF: StripVal()
  654.  
  655. FUNCTION StrPBrk
  656. *-----------------------------------------------------------------------
  657. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  658. *-- Date........: 03/01/1992
  659. *-- Notes.......: Search string for first occurrence of any of the
  660. *--               characters in charset.  Returns its position as
  661. *--               with at().  Contrary to ANSI.C definition, returns
  662. *--               0 if none of characters is found.
  663. *-- Written for.: dBASE IV
  664. *-- Rev. History: 03/01/1992 -- Original Release
  665. *-- Calls.......: None
  666. *-- Called by...: Any
  667. *-- Usage.......: StrPBrk("<cCharSet>","<cBigStr>")
  668. *-- Example.....: ? StrPBrk("Tt",;
  669. *--                   "This is a Test string, with Test data")
  670. *-- Returns.....: Numeric value
  671. *-- Parameters..: cCharSet = characters to look for in cBigStr
  672. *--               cBigStr  = string to look in
  673. *-----------------------------------------------------------------------
  674.  
  675.    parameters cCharset, cBigstring
  676.    private nPos, nLooklen
  677.    m->nPos = 0
  678.    m->nLooklen = len( m->cBigString )
  679.    do while m->nPos < m->nLooklen
  680.       m->nPos = m->nPos + 1
  681.       if at( substr( m->cBigString, m->nPos, 1 ), m->cCharset ) > 0
  682.          exit
  683.       endif
  684.    enddo
  685.    
  686. RETURN iif(m->nPos=m->nLooklen,0,m->nPos)
  687. *-- EoF: StrPBrk()
  688.  
  689. FUNCTION Hav
  690. *-----------------------------------------------------------------------
  691. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  692. *-- Date........: 03/01/1992
  693. *-- Notes.......: Haversine of an angle in radians
  694. *-- Written for.: dBASE IV, 1.1
  695. *-- Rev. History: 03/01/1992 -- Original Release
  696. *-- Calls.......: None
  697. *-- Called by...: Any
  698. *-- Usage.......: Hav(<nX>)
  699. *-- Example.....: ?Hav(48)
  700. *-- Returns.....: Numeric
  701. *-- Parameters..: nX = Return Hav of X
  702. *-----------------------------------------------------------------------
  703.  
  704.    parameters nX
  705.    
  706. RETURN ( 1 - cos( m->nX ) ) / 2
  707. *-- EoF: Hav()
  708.  
  709. FUNCTION AHav
  710. *-----------------------------------------------------------------------
  711. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  712. *-- Date........: 03/01/1992
  713. *-- Notes.......: Inverse haversine - angle size in radians for given
  714. *--               haversine
  715. *-- Written for.: dBASE IV, 1.1
  716. *-- Rev. History: 03/01/1992 -- Original Release
  717. *-- Calls.......: None
  718. *-- Called by...: Any
  719. *-- Usage.......: AHav(<nX>)
  720. *-- Example.....: ?AHav(48)
  721. *-- Returns.....: Numeric
  722. *-- Parameters..: nX = Return AHav of X
  723. *-----------------------------------------------------------------------
  724.  
  725.    parameters nX
  726.    
  727. RETURN acos( 1 - 2 * m->nX )
  728. *-- EoF: AHav()
  729.  
  730. FUNCTION SinH
  731. *-----------------------------------------------------------------------
  732. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  733. *-- Date........: 03/01/1992
  734. *-- Notes.......: Hyperbolic sine of an angle X in radians
  735. *-- Written for.: dBASE IV, 1.1
  736. *-- Rev. History: 03/01/1992 -- Original Release
  737. *-- Calls.......: None
  738. *-- Called by...: Any
  739. *-- Usage.......: SinH(<nX>)
  740. *-- Example.....: ?SinH(48)
  741. *-- Returns.....: Numeric
  742. *-- Parameters..: nX = Return SinH of X
  743. *-----------------------------------------------------------------------
  744.  
  745.    parameters m->nX
  746.    
  747. RETURN ( exp( m->nX ) - exp( -m->nX ) ) / 2
  748. *-- EoF: SinH()
  749.  
  750. FUNCTION CScH
  751. *-----------------------------------------------------------------------
  752. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  753. *-- Date........: 03/01/1992
  754. *-- Notes.......: Hyperbolic cosecant of an angle X in radians
  755. *-- Written for.: dBASE IV, 1.1
  756. *-- Rev. History: 03/01/1993 -- Original Release
  757. *-- Calls.......: SINH()               Function in TRIG.PRG
  758. *-- Called by...: Any
  759. *-- Usage.......: CScH(<nX>)
  760. *-- Example.....: ?CScH(48)
  761. *-- Returns.....: Numeric
  762. *-- Parameters..: nX = Return CScH of X
  763. *-----------------------------------------------------------------------
  764.  
  765.    parameters nX
  766.    
  767. RETURN 1 / sinh( m->nX )
  768. *-- EoF: CScH()
  769.  
  770. *-----------------------------------------------------------------------
  771. *-- EoP: NAVIGATE.PRG
  772. *-----------------------------------------------------------------------
  773.